home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
lstcal15.zip
/
LISTCALL.BAS
next >
Wrap
BASIC Source File
|
1990-10-26
|
8KB
|
344 lines
' List the RBBS Callers file several ways Ver. 1.5
' Copyright 1989,1990 - Allen P. Dew
'
1000 KEY OFF: CLS
ON ERROR GOTO 9900
ONAT$ = "on at"
LNT$ = "} "
UPLD$ = ">> uploaded"
DNLD$ = "Downloaded"
KILD$ = "Killed Msg"
DRV$ = "D:"
CNAM$ = "CALLERS"
INPUT "CALLERS file is on drive:path [D:]"; XDRV$
INPUT "Name of [CALLERS] file: "; XCNAM$
IF XDRV$ <> "" THEN DRV$ = XDRV$
IF XCNAM$ <> "" THEN CNAM$ = XCNAM$
FINAM$ = DRV$ + CNAM$
OPEN FINAM$ FOR INPUT AS #1
CLOSE #1
OPEN "R", #1, FINAM$, 64
FIELD #1, 64 AS N$
LAST& = LOF(1) / 64
1100 CLS
CNT = 0
LOCATE 1, 8
PRINT "Copyright 1990 Allen Dew Geneal Board 919-471-6026";
LOCATE 2, 18
PRINT "== List the RBBS Callers File == V1.5"
PRINT
PRINT TAB(20); "A - List all"
PRINT TAB(20); "B - List all uploads"
PRINT TAB(20); "C - List all downloads"
PRINT TAB(20); "D - List a callers uploads"
PRINT TAB(20); "E - List a callers downloads"
PRINT TAB(20); "F - List a file uploaded"
PRINT TAB(20); "G - List a file downloaded"
PRINT TAB(20); "H - List callers date,time,length,baud"
PRINT TAB(20); "I - List a callers logins"
PRINT TAB(20); "J - List killed messages"
PRINT TAB(20); "K - Search for any string"
PRINT TAB(20); "W - Open a different Caller file"
PRINT TAB(20); "X - Exit this program"
1200 LOCATE 18, 1
PRINT TAB(20); "Enter letter to do ==> "
LOCATE 18, 43
INPUT "", Act$
Act$ = UCASE$(LEFT$(Act$, 1))
SELECT CASE Act$
CASE IS = "X"
GOTO 9000
CASE IS = "W"
CLOSE
GOTO 1000
CASE IS = "A"
GOSUB 3000
CASE IS = "B"
GOSUB 3200
CASE IS = "C"
GOSUB 3400
CASE IS = "D"
GOSUB 3600
CASE IS = "E"
GOSUB 3800
CASE IS = "F"
GOSUB 4000
CASE IS = "G"
GOSUB 4200
CASE IS = "H"
GOSUB 4400
CASE IS = "I"
GOSUB 4600
CASE IS = "J"
GOSUB 4800
CASE IS = "K"
GOSUB 5000
CASE ELSE
BEEP
GOTO 1200
END SELECT
GOTO 1100
3000 ' LIST ALL
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
L$ = N$
GOSUB 8000
NEXT I&
GOSUB 8200
RETURN
3200 ' LIST ALL UPLOAD
Varb$ = UPLD$
GOSUB 7500
RETURN
3400 ' LIST ALL DOWNLOAD
Varb$ = DNLD$
GOSUB 7500
RETURN
3600 ' LIST A CALLERS UPLOADS
Lyn$ = "Name of caller to search for "
GOSUB 8400
IF LEN(CALR$) < 1 THEN 3600
CALR$ = UCASE$(CALR$)
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
W% = INSTR(N$, ONAT$)
X% = INSTR(N$, LNT$)
IF W% <> 0 THEN
W$ = N$
M% = 1
END IF
IF M% = 1 THEN L% = INSTR(W$, CALR$)
IF X% <> 0 THEN X$ = N$
K% = INSTR(N$, UPLD$)
IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
L$ = W$
GOSUB 8000
L$ = X$
GOSUB 8000
M% = 0
END IF
IF K% <> 0 AND L% <> 0 THEN
L$ = N$
GOSUB 8000
END IF
NEXT I&
GOSUB 8200
RETURN
3800 ' LIST A CALLERS DOWNLOADS
Lyn$ = "Name of caller to search for "
GOSUB 8400
IF LEN(CALR$) < 1 THEN 3800
CALR$ = UCASE$(CALR$)
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
W% = INSTR(N$, ONAT$)
X% = INSTR(N$, LNT$)
IF W% <> 0 THEN
W$ = N$
M% = 1
END IF
IF M% = 1 THEN L% = INSTR(W$, CALR$)
IF X% <> 0 THEN X$ = N$
K% = INSTR(N$, DNLD$)
IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
L$ = W$
GOSUB 8000
L$ = X$
GOSUB 8000
M% = 0
END IF
IF K% <> 0 AND L% <> 0 THEN
L$ = N$
GOSUB 8000
END IF
NEXT I&
GOSUB 8200
RETURN
4000 ' LIST FILE UPLOADED
Lyn$ = "Name of file to search for "
GOSUB 8400
IF LEN(CALR$) < 1 THEN 4800
CALR$ = UCASE$(CALR$)
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
W% = INSTR(N$, ONAT$)
X% = INSTR(N$, LNT$)
IF W% <> 0 THEN
W$ = N$
M% = 1
END IF
IF X% <> 0 THEN X$ = N$
K% = INSTR(N$, UPLD$)
IF K% <> 0 THEN L% = INSTR(N$, CALR$)
IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
L$ = W$
GOSUB 8000
L$ = X$
GOSUB 8000
M% = 0
END IF
IF K% <> 0 AND L% <> 0 THEN
L$ = N$
GOSUB 8000
END IF
NEXT I&
GOSUB 8200
RETURN
4200 ' LIST FILE DOWNLOADED
Lyn$ = "Name of file to search for "
GOSUB 8400
IF LEN(CALR$) < 1 THEN 4200
CALR$ = UCASE$(CALR$)
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
W% = INSTR(N$, ONAT$)
X% = INSTR(N$, LNT$)
IF W% <> 0 THEN
W$ = N$
M% = 1
END IF
IF X% <> 0 THEN X$ = N$
K% = INSTR(N$, DNLD$)
IF K% <> 0 THEN L% = INSTR(N$, CALR$)
IF K% <> 0 AND M% <> 0 AND L% <> 0 THEN
L$ = W$
GOSUB 8000
L$ = X$
GOSUB 8000
M% = 0
END IF
IF K% <> 0 AND L% <> 0 THEN
L$ = N$
GOSUB 8000
END IF
NEXT I&
GOSUB 8200
RETURN
4400 ' LIST CALLERS DATE,TIME,LENGTH,BAUD
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
K% = INSTR(N$, ONAT$)
IF K% <> 0 THEN
P$ = N$
I& = I& - 1
GOSUB 8300
Q$ = P$ + N$
L% = INSTR(Q$, ONAT$) - 2
NAM$ = LEFT$(Q$, L%)
NAM$ = NAM$ + SPACE$(30)
NAM$ = LEFT$(NAM$, 30)
TOS$ = MID$(Q$, 119, 9)
DAT$ = MID$(Q$, L% + 8, 8)
TIM$ = MID$(Q$, L% + 18, 8)
R% = INSTR(Q$, " BAUD")
BPS$ = MID$(Q$, R% - 4, 15)
L$ = NAM$ + DAT$ + " " + TIM$ + " " + TOS$ + " " + BPS$
GOSUB 8000
Q$ = ""
END IF
NEXT I&
GOSUB 8200
RETURN
4600 ' LIST A CALLERS LOGINS
Lyn$ = "Name of caller to search for "
GOSUB 8400
IF LEN(CALR$) < 1 THEN 4600
CALR$ = UCASE$(CALR$)
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
W% = INSTR(N$, ONAT$)
IF W% <> 0 THEN
M% = 1
L% = 0
END IF
IF M% <> 0 THEN L% = INSTR(N$, CALR$)
IF L% <> 0 THEN
L$ = N$
GOSUB 8000
END IF
M% = 0
NEXT I&
GOSUB 8200
RETURN
4800 ' LIST KILLED MESSAGES
Varb$ = KILD$
GOSUB 7500
RETURN
5000 ' SEARCH FOR ANY STRING
Lyn$ = "Enter string for search "
GOSUB 8400
IF LEN(CALR$) < 1 THEN 5000
Varb$ = CALR$
GOSUB 7500
RETURN
7500 ' LIST VARIABLE SEARCH DATA
Varc$ = UCASE$(Varb$)
FOR I& = LAST& TO 1 STEP -1
GOSUB 8300
W% = INSTR(N$, ONAT$)
X% = INSTR(N$, LNT$)
IF W% <> 0 THEN
W$ = N$
M% = 1
END IF
IF X% <> 0 THEN X$ = N$
Y$ = UCASE$(N$)
K% = INSTR(Y$, Varc$)
IF K% <> 0 AND M% <> 0 THEN
L$ = W$
GOSUB 8000
L$ = X$
GOSUB 8000
M% = 0
END IF
IF K% <> 0 THEN
L$ = N$
GOSUB 8000
END IF
NEXT I&
GOSUB 8200
RETURN
8000 '
PRINT L$
CNT = CNT + 1
IF CNT < 23 THEN RETURN
CNT = 0
INPUT "--more--[y]/n"; CNT$
CNT$ = UCASE$(LEFT$(CNT$, 1))
IF CNT$ = "N" THEN I& = 0
RETURN
8200 '
PRINT ""
INPUT "That's all. Enter to continue.", CNT$
RETURN
8300 '
GET #1, I&
TEST$ = INKEY$
IF LEN(TEST$) = 0 THEN RETURN
IF ASC(TEST$) = 27 THEN I& = 1
RETURN
8400 '
LOCATE 20, 10
PRINT "Use the ESC key to halt search."
LOCATE 21, 10
PRINT Lyn$;
INPUT CALR$
PRINT
RETURN
9000 '
CLOSE
CLS
SYSTEM
9900 '
IF ERR <> 53 THEN ' FILE NOT FOUND
PRINT "Error "; ERR; " at line "; ERL
END
END IF
PRINT ""
INPUT "Callers file not found. Retry ? Y/N ", CNT$
CNT$ = UCASE$(LEFT$(CNT$, 1))
IF CNT$ = "Y" THEN RESUME 1000
IF CNT$ = "N" THEN RESUME 9000
GOTO 9900